home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / DB_CLIPP / 0669.ZIP / SETPASS.PRG < prev    next >
Text File  |  1985-12-30  |  2KB  |  86 lines
  1. * PROGRAM NAME.....SETPASS.PRG
  2. * AUTHOR...........MIKE COTICCHIO
  3. * NOTES............This program is used to initialize username 
  4. *                  and passwords.  The password can be encrypted, 
  5. *                  if desired.
  6.  
  7. use logon index logon
  8. store 'N' to answer
  9.  
  10. **** The following loop checks username to make sure it is unique ****
  11.  
  12. do while answer <> 'Y'
  13.  clear
  14.  store space(15) to username
  15.  store space(1) to answer
  16.  @ 5,5 say "Username (maximum of 15 letters): ";
  17.   get username picture '@!'
  18.  read
  19.  
  20. **** If user wants to bail out of program, a carriage return in ****
  21. **** response to the prompt will allow it                       ****
  22.  
  23.  if asc(username) = 32
  24.   clear
  25.   close database
  26.   return
  27.  endif
  28.  find &username
  29.  if .not. eof()
  30.   ? chr(7)
  31.   @ 10,5 say trim(username)+ ' already exists.  Select another.'
  32.   ?
  33.   ?
  34.   wait
  35.   loop
  36.  endif
  37.  @ 10,5 say trim(username)+', is that correct? ' get answer picture
  38. '@!'
  39.  read
  40. enddo
  41. @ 10,0 clear
  42. store .f. to passmatch
  43.  
  44. **** Loop to accept and verify password ****
  45.  
  46. do while .not. passmatch
  47.  @ 10,5 say "Enter password (maximum of 10 letters): "
  48.  
  49. **** Set color to 0/0 blanks screen so that input cannot be read ****
  50.  
  51.  set color to 0/0
  52.  accept to password1
  53.  
  54. **** Set color back to normal - change value as desired ****
  55.  
  56.  set color to 3/0
  57.  @ 12,5 say "Re-enter password: "
  58.  set color to 0/0
  59.  accept to password2
  60.  set color to 3/0
  61.  if upper(password1) = upper(password2)
  62.   store .t. to passmatch
  63.  else
  64.   @ 10,0 clear
  65.   ? chr(7)
  66.   Wait "Passwords don't match - strike any key to try again!"
  67.   @ 10,0 clear
  68.  endif
  69. enddo
  70. store upper(password1) to password1
  71.  
  72. **** The encryption routine is called here.  If encryption not ****
  73. **** needed this section should be deleted                     ****
  74.  
  75. store space(10) to encrypted
  76. @ 10,0 clear
  77. @ 10,5 say "Encrypting password..."
  78. do encrypt with password1,encrypted
  79. store encrypted to password1
  80.  
  81. **** End of call to encryption routine ****
  82.  
  83. append blank
  84. replace name with username, password with password1
  85. clear
  86. return